home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
PASCAL
/
0195.ZIP
/
GTSETDIR.LIB
< prev
next >
Wrap
Text File
|
1984-12-03
|
2KB
|
51 lines
{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.
Any program that INCLUDES GtSetDir MUST include FILENAME.TYP
and REGPACK.TYP
(This is in order to avoid multiple declarations)
}
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure GetSetDirectory(activity : char;
VAR drive : char;
VAR directory : filename_type;
VAR error : byte);
var
registers : regpack;
begin
activity := upCase(activity);
with registers do
begin
case activity of
'G': begin
DX := ord(UpCase(drive))-64;
DS := seg(directory);
SI := ofs(directory)+1;
AX := $47 shl 8;
end;
'S': begin
directory[length(directory)+1] := #0;
DS := seg(directory);
DX := ofs(directory)+1;
AX := $3B shl 8;
end;
end; {case}
MSDOS(registers);
if Flags and 1 = 1 then
error := AX and $00FF
else
begin
error := 0;
if activity = 'G' then
begin
directory := copy(directory,1,pos(#0,directory)-1);
directory := drive + ':\' + directory;
end;
end;
end; {with}
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}